//////////
// 流程控制：begin/if/cond/case/quit

#include <memory.h>
#include "../basic/operator.h"

Cell* op_begin(Scheme *sc) {
	log(sc, "syntax/control", "op_begin");
	//形式 (begin body ...)
	if (!type_of(sc, sc->code, PAIR_TYPE)) {
		sc->returnValue = sc->code;
		return pop_callstack(sc); //这里这样的代码可以通过(begin . 1)
	}
	if (cdr(sc->code) != G_NIL) {
		push_callstack(sc, cell_op_begin, G_NIL, cdr(sc->code)); //保存剩余的未求值的部分
	}
	sc->code = car(sc->code);
	sc->op = cell_op_eval;
	log(sc, "syntax/control", "op_begin");
	return G_TRUE;
}

//if的形式 (if condition true_body false_body?) ， false_body可有可无
Cell* op_if0(Scheme *sc) {
	log(sc, "syntax/control", "op_if0");
	push_callstack(sc, cell_op_if1, G_NIL, cdr(sc->code)); //这里cdr(sc->code) 结果是(true_body false_body?)
	sc->code = car(sc->code); //最后 sc->code 是条件
	sc->op = cell_op_eval; //对条件求值
	log(sc, "syntax/control", "op_if0");
	return G_TRUE;
}

Cell* op_if1(Scheme *sc) {
	log(sc, "syntax/control", "op_if1");
	if (is_true(sc->returnValue))
		sc->code = first(sc->code); //最后sc->code为true_body
	else
		sc->code = second(sc->code); //最后sc->code为false_body
	sc->op = cell_op_eval; //对true_body或者false_body求值
	log(sc, "syntax/control", "op_if1");
	return G_TRUE;
}

Cell* op_cond0(Scheme *sc) {
	log(sc, "syntax/control", "op_cond0");
	//形式1 (cond (cond_expr ) ...)
	//形式2 (cond (cond_expr  body) ...)
	//形式3 (cond (cond_expr => body) ...)
	if (!type_of(sc, sc->code, PAIR_TYPE))
		return make_default_exception(sc, "SYNTAX_ERROR", "syntax error in cond");
	push_callstack(sc, cell_op_cond1, G_NIL, sc->code);
	sc->code = caar(sc->code); //sc->code 变为 cond_expr
	sc->op = cell_op_eval;
	log(sc, "syntax/control", "op_cond0");
	return G_TRUE;
}

Cell* op_cond1(Scheme *sc) {
	log(sc, "syntax/control", "op_cond1");
	Cell *x;
	if (is_true(sc->returnValue)) {
		if ((sc->code = cdar(sc->code)) == G_NIL) {
			log(sc, "syntax/control", "op_cond1");
			return pop_callstack(sc); //形式1   这里 sc->code 被改变了
		}
		if (car(sc->code) == cell_feed_to) { //形式3 这里如果通过 sc->code 应当为  (=> body)
			if (!type_of(sc, cdr(sc->code), PAIR_TYPE))
				return make_default_exception(sc, "SYNTAX_ERROR", "syntax error in cond");
			//x 为  '(sc->returnValue)  之所以这个样子
			//1 参数要放到列表里面，2 这里body是一个处理过程，这个形式确保sc->returnValue不被进一步求值直接交给body
			//例子 (cond ('(1 2) => list))   结果 ((1 2))
			x = cons(sc, cell_quote, cons(sc, sc->returnValue, G_NIL));
			sc->code = cons(sc, cadr(sc->code), cons(sc, x, G_NIL));
			sc->op = cell_op_eval;
			log(sc, "syntax/control", "op_cond1");
			return G_TRUE;
		}
		//形式2  如果到这里 sc->code 应当为  (body)
		sc->op = cell_op_begin;
		log(sc, "syntax/control", "op_cond1");
		return G_TRUE;
	} else { //循环求值
		if ((sc->code = cdr(sc->code)) == G_NIL) {
			sc->returnValue = G_NIL;
			log(sc, "syntax/control", "op_cond1");
			return pop_callstack(sc);
		} else {
			push_callstack(sc, cell_op_cond1, G_NIL, sc->code);
			sc->code = caar(sc->code);
			sc->op = cell_op_eval;
			log(sc, "syntax/control", "op_cond1");
			return G_TRUE;
		}
	}
}

Cell* op_case0(Scheme *sc) {
	log(sc, "syntax/control", "op_case0");
	//形式 (case cond_expr (test_expr body) ...)
	push_callstack(sc, cell_op_case1, G_NIL, cdr(sc->code));
	sc->code = car(sc->code); //cond_expr
	//对条件进行求值
	sc->op = cell_op_eval;
	log(sc, "syntax/control", "op_case0");
	return G_TRUE;
}

Cell* op_case1(Scheme *sc) {
	log(sc, "syntax/control", "op_case1");
	Cell *x, *y;
	//sc->code为((test_expr body) ...)
	for (x = sc->code; x != G_NIL; x = cdr(x)) {
		y = caar(x);
		if (!type_of(sc, y, PAIR_TYPE)) {
			if (eqv(sc, y, sc->returnValue) || strcmp(y->_name, "else") == 0)
				break;
		}
		for (; y != G_NIL; y = cdr(y)) {
			if (eqv(sc, car(y), sc->returnValue))
				break;
		}
		if (y != G_NIL)
			break;
	}
	if (x != G_NIL) {
		sc->code = cdar(x); //sc->code 变为 (body)
        sc->op = cell_op_begin;
		log(sc, "syntax/control", "op_case1");
		return G_TRUE;
	}
	sc->returnValue = G_NIL;
	log(sc, "syntax/control", "op_case1");
	return pop_callstack(sc);
}


// (quit)
Cell* op_quit(Scheme *sc) {
	return G_NIL;
}

void init_control_operators(Scheme *sc) {
	ADD_OPERATOR(sc, "$begin", begin);
	ADD_OPERATOR(sc, "$if0", if0);
	ADD_OPERATOR(sc, "$if1", if1);
	ADD_OPERATOR(sc, "$cond0", cond0);
	ADD_OPERATOR(sc, "$cond1", cond1);
	ADD_OPERATOR(sc, "$case0", case0);
	ADD_OPERATOR(sc, "$case1", case1);
	ADD_OPERATOR(sc, "quit", quit);

	ADD_SYNTAX(sc, "begin", begin);
	ADD_SYNTAX(sc, "if", if0);
	ADD_SYNTAX(sc, "cond", cond0);
	ADD_SYNTAX(sc, "case", case0);
}
